home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_pas / multastp / tasker.pas < prev   
Pascal/Delphi Source File  |  1988-01-07  |  3KB  |  134 lines
  1. Unit Tasker;
  2. {$R- ,$S- ,$N-}
  3. {
  4.   Non-Preemptive MultiTasking Unit
  5.   for Turbo Pascal Version 4
  6.  
  7.   Author  : Michael Warot
  8.   Date    : November 1987
  9.   Purpose : Simple multi-tasking for turbo pascal 4.0
  10. }
  11. Interface
  12.  
  13. Const
  14.   MaxProc   = 20;
  15.  
  16. Type
  17.   ProcState = (Dead,Live,Pause,Sleep);
  18.  
  19.   SpaceRec  = Array[0..$1000] of Byte;
  20.   SpacePtr  = ^SpaceRec;
  21.  
  22.   Task_Rec  = Record
  23.                 ID     : Word;        { Process Number }
  24.                 Base,                 { BP save area   }
  25.                 Stack  : Word;        { SS save area   }
  26.                 State  : ProcState;   { Is it a live process ? }
  27.               End; { Record }
  28. Var
  29.   BP_save,SS_save   : Word;
  30.   BP_load,SS_load   : Word;
  31.  
  32.   New_Ptr   : SpacePtr;
  33.  
  34.   Procs     : Array[0..MaxProc] of Task_Rec;
  35.   LastP     : Word;
  36.   NextP     : Word;
  37.   ThisP     : Word;
  38.   LiveCount : Word;                   { How many thing happening? }
  39.  
  40. {$F+}
  41. Procedure Fork;
  42. Procedure Yield;
  43. Procedure KillProc;
  44. Function  Child_Process:Boolean;
  45. Procedure Init_Tasking;
  46.  
  47. Implementation
  48.  
  49. Procedure SaveFrame; Inline($89/$2e/BP_save/$8c/$16/SS_save);
  50.  
  51. Procedure LoadFrame; Inline($8b/$2e/BP_load/$8e/$16/SS_load);
  52.  
  53. {$F+}
  54. Procedure Fork;
  55. Begin
  56.   inline($90/$90/$90);
  57.   SaveFrame;
  58.   If (ThisP = 0) and (LastP < MaxProc) then
  59.   begin
  60.  
  61.     Procs[ThisP].ID    := ThisP;
  62.     Procs[ThisP].Base  := BP_Save;
  63.     Procs[ThisP].Stack := SS_Save;
  64.     Procs[ThisP].State := Live;
  65.  
  66.     Inc(NextP);
  67.     Inc(LastP);
  68.  
  69.     New(New_Ptr);
  70.  
  71.     Procs[NextP].ID    := NextP;
  72.     Procs[NextP].Base  := ofs(new_ptr^[$0f00]);
  73.     Procs[NextP].Stack := seg(new_ptr^[$0f00]);
  74.     Procs[NextP].State := Live;
  75.     Move(Ptr(SS_save,BP_Save)^,new_ptr^[$0f00],$10);
  76.  
  77.     Inc(LiveCount);
  78.   end; { if root process }
  79.  
  80.   bp_load := bp_save;
  81.   ss_load := ss_save;
  82.  
  83.   LoadFrame;
  84. End; { Fork }
  85. {$F-}
  86.  
  87. {$F+}
  88. Procedure Yield;
  89. Begin
  90.   SaveFrame;
  91.  
  92.   Procs[ThisP].Base  := BP_Save;
  93.   Procs[ThisP].Stack := SS_Save;
  94.  
  95.   If LiveCount > 1 then
  96.   begin
  97.     repeat
  98.       ThisP := NextP;
  99.       NextP := Succ(NextP); If NextP > LastP then NextP := 0;
  100.     until Procs[ThisP].State <> Dead;
  101.   end;
  102.  
  103.   bp_load := Procs[ThisP].Base;
  104.   ss_load := Procs[ThisP].Stack;
  105.   LoadFrame;
  106. End; { Yield }
  107. {$F-}
  108.  
  109. Procedure KillProc;
  110. Begin
  111.   If LiveCount > 1 then
  112.   begin
  113.     Procs[ThisP].State := Dead;
  114.     LiveCount := Pred(LiveCount);
  115.     Yield;
  116.   end
  117.   else
  118.     Halt(0);
  119. End; { KillProc }
  120.  
  121. Function Child_Process : Boolean;
  122. Begin
  123.   Child_Process := ThisP <> 0;
  124. End;
  125.  
  126. Procedure Init_Tasking;
  127. Begin
  128.   LastP := 0;
  129.   ThisP := 0;
  130.   NextP := 0;
  131.   LiveCount := 1; { This task! }
  132. End;
  133.  
  134. End. { Unit }